home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / lib / perl / 5.10.0 / IPC / Semaphore.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-26  |  5.8 KB  |  303 lines
  1. # IPC::Semaphore
  2. #
  3. # Copyright (c) 1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
  4. # This program is free software; you can redistribute it and/or
  5. # modify it under the same terms as Perl itself.
  6.  
  7. package IPC::Semaphore;
  8.  
  9. use IPC::SysV qw(GETNCNT GETZCNT GETVAL SETVAL GETPID GETALL SETALL
  10.          IPC_STAT IPC_SET IPC_RMID);
  11. use strict;
  12. use vars qw($VERSION);
  13. use Carp;
  14.  
  15. $VERSION = "1.02";
  16. $VERSION = eval $VERSION;
  17.  
  18. {
  19.     package IPC::Semaphore::stat;
  20.  
  21.     use Class::Struct qw(struct);
  22.  
  23.     struct 'IPC::Semaphore::stat' => [
  24.     uid    => '$',
  25.     gid    => '$',
  26.     cuid    => '$',
  27.     cgid    => '$',
  28.     mode    => '$',
  29.     ctime    => '$',
  30.     otime    => '$',
  31.     nsems    => '$',
  32.     ];
  33. }
  34.  
  35. sub new {
  36.     @_ == 4 || croak 'new ' . __PACKAGE__ . '( KEY, NSEMS, FLAGS )';
  37.     my $class = shift;
  38.  
  39.     my $id = semget($_[0],$_[1],$_[2]);
  40.  
  41.     defined($id)
  42.     ? bless \$id, $class
  43.     : undef;
  44. }
  45.  
  46. sub id {
  47.     my $self = shift;
  48.     $$self;
  49. }
  50.  
  51. sub remove {
  52.     my $self = shift;
  53.     (semctl($$self,0,IPC_RMID,0), undef $$self)[0];
  54. }
  55.  
  56. sub getncnt {
  57.     @_ == 2 || croak '$sem->getncnt( SEM )';
  58.     my $self = shift;
  59.     my $sem = shift;
  60.     my $v = semctl($$self,$sem,GETNCNT,0);
  61.     $v ? 0 + $v : undef;
  62. }
  63.  
  64. sub getzcnt {
  65.     @_ == 2 || croak '$sem->getzcnt( SEM )';
  66.     my $self = shift;
  67.     my $sem = shift;
  68.     my $v = semctl($$self,$sem,GETZCNT,0);
  69.     $v ? 0 + $v : undef;
  70. }
  71.  
  72. sub getval {
  73.     @_ == 2 || croak '$sem->getval( SEM )';
  74.     my $self = shift;
  75.     my $sem = shift;
  76.     my $v = semctl($$self,$sem,GETVAL,0);
  77.     $v ? 0 + $v : undef;
  78. }
  79.  
  80. sub getpid {
  81.     @_ == 2 || croak '$sem->getpid( SEM )';
  82.     my $self = shift;
  83.     my $sem = shift;
  84.     my $v = semctl($$self,$sem,GETPID,0);
  85.     $v ? 0 + $v : undef;
  86. }
  87.  
  88. sub op {
  89.     @_ >= 4 || croak '$sem->op( OPLIST )';
  90.     my $self = shift;
  91.     croak 'Bad arg count' if @_ % 3;
  92.     my $data = pack("s!*",@_);
  93.     semop($$self,$data);
  94. }
  95.  
  96. sub stat {
  97.     my $self = shift;
  98.     my $data = "";
  99.     semctl($$self,0,IPC_STAT,$data)
  100.     or return undef;
  101.     IPC::Semaphore::stat->new->unpack($data);
  102. }
  103.  
  104. sub set {
  105.     my $self = shift;
  106.     my $ds;
  107.  
  108.     if(@_ == 1) {
  109.     $ds = shift;
  110.     }
  111.     else {
  112.     croak 'Bad arg count' if @_ % 2;
  113.     my %arg = @_;
  114.     $ds = $self->stat
  115.         or return undef;
  116.     my($key,$val);
  117.     $ds->$key($val)
  118.         while(($key,$val) = each %arg);
  119.     }
  120.  
  121.     my $v = semctl($$self,0,IPC_SET,$ds->pack);
  122.     $v ? 0 + $v : undef;
  123. }
  124.  
  125. sub getall {
  126.     my $self = shift;
  127.     my $data = "";
  128.     semctl($$self,0,GETALL,$data)
  129.     or return ();
  130.     (unpack("s!*",$data));
  131. }
  132.  
  133. sub setall {
  134.     my $self = shift;
  135.     my $data = pack("s!*",@_);
  136.     semctl($$self,0,SETALL,$data);
  137. }
  138.  
  139. sub setval {
  140.     @_ == 3 || croak '$sem->setval( SEM, VAL )';
  141.     my $self = shift;
  142.     my $sem = shift;
  143.     my $val = shift;
  144.     semctl($$self,$sem,SETVAL,$val);
  145. }
  146.  
  147. 1;
  148.  
  149. __END__
  150.  
  151. =head1 NAME
  152.  
  153. IPC::Semaphore - SysV Semaphore IPC object class
  154.  
  155. =head1 SYNOPSIS
  156.  
  157.     use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR IPC_CREAT);
  158.     use IPC::Semaphore;
  159.  
  160.     $sem = new IPC::Semaphore(IPC_PRIVATE, 10, S_IRUSR | S_IWUSR | IPC_CREAT);
  161.  
  162.     $sem->setall( (0) x 10);
  163.  
  164.     @sem = $sem->getall;
  165.  
  166.     $ncnt = $sem->getncnt;
  167.  
  168.     $zcnt = $sem->getzcnt;
  169.  
  170.     $ds = $sem->stat;
  171.  
  172.     $sem->remove;
  173.  
  174. =head1 DESCRIPTION
  175.  
  176. A class providing an object based interface to SysV IPC semaphores.
  177.  
  178. =head1 METHODS
  179.  
  180. =over 4
  181.  
  182. =item new ( KEY , NSEMS , FLAGS )
  183.  
  184. Create a new semaphore set associated with C<KEY>. C<NSEMS> is the number
  185. of semaphores in the set. A new set is created if
  186.  
  187. =over 4
  188.  
  189. =item *
  190.  
  191. C<KEY> is equal to C<IPC_PRIVATE>
  192.  
  193. =item *
  194.  
  195. C<KEY> does not already  have  a  semaphore  identifier
  196. associated with it, and C<I<FLAGS> & IPC_CREAT> is true.
  197.  
  198. =back
  199.  
  200. On creation of a new semaphore set C<FLAGS> is used to set the
  201. permissions.  Be careful not to set any flags that the Sys V
  202. IPC implementation does not allow: in some systems setting
  203. execute bits makes the operations fail.
  204.  
  205. =item getall
  206.  
  207. Returns the values of the semaphore set as an array.
  208.  
  209. =item getncnt ( SEM )
  210.  
  211. Returns the number of processes waiting for the semaphore C<SEM> to
  212. become greater than its current value
  213.  
  214. =item getpid ( SEM )
  215.  
  216. Returns the process id of the last process that performed an operation
  217. on the semaphore C<SEM>.
  218.  
  219. =item getval ( SEM )
  220.  
  221. Returns the current value of the semaphore C<SEM>.
  222.  
  223. =item getzcnt ( SEM )
  224.  
  225. Returns the number of processes waiting for the semaphore C<SEM> to
  226. become zero.
  227.  
  228. =item id
  229.  
  230. Returns the system identifier for the semaphore set.
  231.  
  232. =item op ( OPLIST )
  233.  
  234. C<OPLIST> is a list of operations to pass to C<semop>. C<OPLIST> is
  235. a concatenation of smaller lists, each which has three values. The
  236. first is the semaphore number, the second is the operation and the last
  237. is a flags value. See L<semop> for more details. For example
  238.  
  239.     $sem->op(
  240.     0, -1, IPC_NOWAIT,
  241.     1,  1, IPC_NOWAIT
  242.     );
  243.  
  244. =item remove
  245.  
  246. Remove and destroy the semaphore set from the system.
  247.  
  248. =item set ( STAT )
  249.  
  250. =item set ( NAME => VALUE [, NAME => VALUE ...] )
  251.  
  252. C<set> will set the following values of the C<stat> structure associated
  253. with the semaphore set.
  254.  
  255.     uid
  256.     gid
  257.     mode (only the permission bits)
  258.  
  259. C<set> accepts either a stat object, as returned by the C<stat> method,
  260. or a list of I<name>-I<value> pairs.
  261.  
  262. =item setall ( VALUES )
  263.  
  264. Sets all values in the semaphore set to those given on the C<VALUES> list.
  265. C<VALUES> must contain the correct number of values.
  266.  
  267. =item setval ( N , VALUE )
  268.  
  269. Set the C<N>th value in the semaphore set to C<VALUE>
  270.  
  271. =item stat
  272.  
  273. Returns an object of type C<IPC::Semaphore::stat> which is a sub-class of
  274. C<Class::Struct>. It provides the following fields. For a description
  275. of these fields see your system documentation.
  276.  
  277.     uid
  278.     gid
  279.     cuid
  280.     cgid
  281.     mode
  282.     ctime
  283.     otime
  284.     nsems
  285.  
  286. =back
  287.  
  288. =head1 SEE ALSO
  289.  
  290. L<IPC::SysV> L<Class::Struct> L<semget> L<semctl> L<semop> 
  291.  
  292. =head1 AUTHOR
  293.  
  294. Graham Barr <gbarr@pobox.com>
  295.  
  296. =head1 COPYRIGHT
  297.  
  298. Copyright (c) 1997 Graham Barr. All rights reserved.
  299. This program is free software; you can redistribute it and/or modify it
  300. under the same terms as Perl itself.
  301.  
  302. =cut
  303.